home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / emacs.tcl < prev    next >
Encoding:
Text File  |  1997-12-14  |  5.1 KB  |  255 lines  |  [TEXT/ALFA]
  1.  
  2. alpha::extension emacs 0.20 {
  3.     newPref f useEmacsMenu 1 global emacsToggle
  4.     newPref f emacLastWordIfTouching 0 global effectLastToggle    
  5.     menu::buildProc emacs emacsBindings
  6.     emacsToggle
  7.     effectLastToggle
  8.     alpha::addToPreferencePage Packages emacLastWordIfTouching useEmacsMenu
  9. } help {file "Emacs Help"}
  10.  
  11.  
  12. proc effectLastToggle {args} {
  13.     global emacLastWordIfTouching
  14.     if $emacLastWordIfTouching {
  15.         rename upcaseWord __upcaseWord 
  16.         rename downcaseWord __downcaseWord 
  17.         rename capitalizeWord __capitalizeWord 
  18.         ;proc upcaseWord {} {
  19.             set p [getPos]
  20.             backwardWord 
  21.             set sw [getPos]
  22.             forwardWord 
  23.             set ew [getPos]
  24.             goto $p
  25.             if {$p == $ew} {
  26.                 backwardWord 
  27.                 __upcaseWord 
  28.             } else {
  29.                 __upcaseWord 
  30.             } 
  31.         }
  32.         ;proc downcaseWord {} {
  33.             set p [getPos]
  34.             backwardWord 
  35.             set sw [getPos]
  36.             forwardWord 
  37.             set ew [getPos]
  38.             goto $p
  39.             if {$p == $ew} {
  40.                 backwardWord 
  41.                 __downcaseWord 
  42.             } else {
  43.                 __downcaseWord 
  44.             } 
  45.         }
  46.         ;proc capitalizeWord {} {
  47.             set p [getPos]
  48.             backwardWord 
  49.             set sw [getPos]
  50.             forwardWord 
  51.             set ew [getPos]
  52.             goto $p
  53.             if {$p == $ew} {
  54.                 backwardWord 
  55.                 while {![regexp {\w} [lookAt [getPos]]]} {
  56.                     forwardChar 
  57.                 }
  58.                 __capitalizeWord 
  59.             } else {
  60.                 __capitalizeWord 
  61.             } 
  62.         }
  63.         unbind 'h' <z>    hiliteWord
  64.         bind 'h' <z>    touchHiliteWord 
  65.     } else {
  66.         if {[info command __upcaseWord] != ""} {
  67.             rename upcaseWord {}
  68.             rename downcaseWord {}
  69.             rename capitalizeWord {}
  70.             
  71.             rename __upcaseWord upcaseWord 
  72.             rename __downcaseWord downcaseWord 
  73.             rename __capitalizeWord capitalizeWord 
  74.             unbind 'h' <z>    touchHiliteWord 
  75.             bind 'h' <z>    hiliteWord
  76.         } 
  77.     } 
  78. }
  79.  
  80. proc touchHiliteWord {} {
  81.     if {[getPos]==[selEnd]}    {
  82.         set p [getPos]
  83.         backwardWord 
  84.         set sw [getPos]
  85.         forwardWord 
  86.         set ew [getPos]
  87.         goto $p
  88.         if {$p == $ew} {
  89.             select $sw $ew
  90.         } else {
  91.             forwardWord
  92.             set start [getPos]
  93.             backwardWord
  94.             select $start [getPos]
  95.         } 
  96.     } else {
  97.         forwardChar 
  98.         forwardWord
  99.         set start [getPos]
  100.         backwardWord
  101.         select $start [getPos]
  102.     } 
  103. }
  104.  
  105. proc beginningOfLogicalLine {} {
  106.     beginningOfLine
  107.     set p [getPos]
  108.     set limit [expr [nextLineStart $p] -1]
  109.     set llstart [search -f 1 -r 1 -n -l $limit {[^ \t\r\n]} $p]
  110.     if {$llstart != ""} {
  111.         goto [lindex $llstart 0]
  112.     } 
  113. }
  114.  
  115. proc emacsToggle {args} {
  116.     global useEmacsMenu
  117.     if $useEmacsMenu { 
  118.         menu::insert Edit submenu end emacs
  119.     } else {
  120.         menu::removeFrom Edit submenu end emacs
  121.         emacsBindings
  122.     }
  123. }
  124.  
  125. # so things will work ok with tcl 7 or 8
  126. namespace eval alpha {
  127. # Emacs-ish bindings.
  128. bind 0x33 <e>      backwardDeleteWord 
  129. bind 'b' <es>    backwardWordSelect 
  130. bind '<' <se>     beginningOfBuffer 
  131. bind 'b' <X>    chooseWindowStatus 
  132. bind 'l' <X>    currentPosition 
  133. bind ')' <Xs>    endKeyboardMacro 
  134. bind '>' <se>     endOfBuffer 
  135. bind 'x' <Xz>    exchangePointAndMark 
  136. bind 'w' <Xz>    saveAs 
  137. bind 'e' <X>    executeKeyboardMacro 
  138. bind 'f' <Xz>    findFile 
  139. bind 'f' <es>     forwardWordSelect 
  140. bind 'c' <z>     prefixChar 
  141. bind 'x' <z>     prefixChar 
  142. bind 'r' <e>     repeatSearchBackward 
  143. bind 's' <e>     repeatSearchForward 
  144. bind 's' <Xz>    save 
  145. bind '(' <sX>    startKeyboardMacro 
  146. bind 'o' <X>    otherThing 
  147. bind '1' <X>    zoom 
  148. bind 'k' <X>    killWindowStatus
  149. bind 'u' <X>    upcaseWord
  150.  
  151. bind 'f' <e> forwardWord
  152. bind 'b' <e> backwardWord
  153. bind 'd' <e> deleteWord
  154. bind 'h' <e> backwardDeleteWord
  155. bind 'v' <e> pageBack
  156. bind 'w' <e> copy
  157. bind 'g' <e> gotoLine
  158. bind 'e' <e> nextSentence
  159. bind 'a' <e> prevSentence
  160. bind 'c' <e> capitalizeWord
  161. bind 'u' <e> upcaseWord
  162. bind 'l' <e> downcaseWord
  163.  
  164. # added next -trf
  165. bind 'm' <e> beginningOfLogicalLine
  166. bind 'x' <e> execute
  167. bind '\ '  <e> oneSpace
  168. bind '\ '  <o> oneSpace
  169.  
  170. bind 'd' <X>    killRegion
  171. }
  172.  
  173. proc emacsBindings {} {
  174.     global useEmacsMenu
  175.     if $useEmacsMenu {
  176.         menu -n emacs {
  177.         "/F<BforwardChar"
  178.         "/B<BbackwardChar"
  179.         "/D<BdeleteChar"
  180.         "/N<BnextLine"
  181.         "/P<BpreviousLine"
  182.         "(-"
  183.         "/F<IforwardWord"
  184.         "/B<IbackwardWord"
  185.         "/D<IdeleteWord"
  186.         "/v<IdeleteWord"
  187.         "/H<IbackwardDeleteWord"
  188.         "/u<IbackwardDeleteWord"
  189.         "(-"
  190.         "/K<BkillLine"
  191.         "/Y<Byank"
  192.         "/A<BbeginningOfLine"
  193.         "/E<BendOfLine"
  194.         "/O<BopenLine"
  195.         "(-"
  196.         "/V<BpageForward"
  197.         "/V<IpageBack"
  198.         "/L<BcenterRedraw"
  199.         "(-"
  200.         "/ <BsetMark"
  201.         "/W<Bcut"
  202.         "/W<Icopy"
  203.         "(-"
  204.         "/C<IcapitalizeWord"
  205.         "upcaseWord"
  206.         "/L<IdowncaseWord"
  207.         "(-"
  208.         "/X<Iexecute"
  209.         "/U<BiterationCount"
  210.         "/G<BabortEm"
  211.         }
  212.     } else {
  213.         namespace eval alpha {
  214.         bind 'f' <z> forwardChar
  215.         bind 'b' <z> backwardChar
  216.         bind 'd' <z> deleteChar
  217.         bind 'n' <z> nextLine
  218.         bind 'p' <z> previousLine
  219.         bind 'f' <o>  forwardWord
  220.         bind 'b' <o>  backwardWord
  221.         bind 'd' <o>  deleteWord
  222.         bind 0x33 <so> deleteWord 
  223.         bind 'h' <o>  backwardDeleteWord
  224.         bind 0x33 <o>  backwardDeleteWord
  225.         bind 'k' <z> killLine
  226.         bind 'y' <z> yank
  227.         bind 'a' <z> beginningOfLine
  228.         bind 'e' <z> endOfLine
  229.         bind 'o' <z> openLine
  230.         bind 'v' <z> pageForward
  231.         bind 'v' <o> pageBack
  232.         bind 'l' <z> centerRedraw
  233.         bind '\ ' <z> setMark
  234.         bind 'w' <z> cut
  235.         bind 'w' <o> copy
  236.         bind 'c' <o> capitalizeWord
  237.         bind 'l' <o> downcaseWord
  238.         bind 'x' <o> execute
  239.         bind 'u' <z> iterationCount
  240.         bind '.' <z> abortEm
  241.         }
  242.     }
  243. }
  244.  
  245. proc killRegion {} {
  246.     set from [getMark]
  247.     set to [getPos]
  248.     if {$to < $from} {
  249.         deleteText $to $from
  250.     } else {
  251.         deleteText $from $to
  252.     }
  253. }
  254.  
  255.